perm filename CYCXGP.LSP[3,LMM] blob sn#034882 filedate 1973-04-21 generic text, type T, neo UTF8

(DEFPROP CYCXGPFNS
 (CYCXGPFNS (SAVVALUE (QUOTE (REALBOTTOM REALEFT REALHEIGHT EPSILON)))
	    (SAVDEF (QUOTE (APT AIVECT AVECT LABELL INITDRAW ENDDRAW)))
	    APT
	    AIVECT
	    AVECT
	    MOVBITS
	    SELFONT
	    SETFONT
	    PRINCMAKNUM
	    MAKNUM
	    LOGAND
	    LABELL
	    INITDRAW
	    ENDDRAW
	    CLOSEXGP
	    (SETQ XGPOUT NIL)
	    (SETQ REALBOTTOM 1.)
	    (SETQ REALEFT -511.)
	    (SETQ REALHEIGHT (SETQ REALWIDTH 512.))
	    (SETQ EPSILON 0.5))
VALUE)

(SAVVALUE (QUOTE (REALBOTTOM REALEFT REALHEIGHT EPSILON)))

(SAVDEF (QUOTE (APT AIVECT AVECT LABELL INITDRAW ENDDRAW)))

(DEFPROP APT
 (LAMBDA (N1 N2) (PROGN (PRINC (QUOTE /␈)) (PRINC (QUOTE "P")) (PRINCMAKNUM N1) (PRINCMAKNUM N2)))
EXPR)

(DEFPROP AIVECT
 (LAMBDA (N1 N2) (PROGN (PRINC (QUOTE /␈)) (PRINC (QUOTE "I")) (PRINCMAKNUM N1) (PRINCMAKNUM N2)))
EXPR)

(DEFPROP AVECT
 (LAMBDA (N1 N2) (PROGN (PRINC (QUOTE /␈)) (PRINC (QUOTE "V")) (PRINCMAKNUM N1) (PRINCMAKNUM N2)))
EXPR)

(DEFPROP MOVBITS
 (LAMBDA(BITS)
  (COND	((MINUSP BITS) (PRINC (QUOTE /␈)) (PRINC (QUOTE /␈)) (PRINC (ASCII (MINUS BITS))))
	(T (PRINC (QUOTE /␈)) (PRINC (QUOTE " ")) (PRINC (ASCII BITS)))))
EXPR)

(DEFPROP SELFONT
 (LAMBDA (DIG) (PROG2 (PRINC (QUOTE /␈)) (PRINC DIG)))
EXPR)

(DEFPROP SETFONT
 (LAMBDA (FIL DIG) (PROG2 (PRINC (QUOTE /␈)) (PRINC λ) (PRINC FIL) (PRINC PP) (PRINC DIG)))
EXPR)

(DEFPROP PRINCMAKNUM
 (LAMBDA (I) (PROG2 (TYO (PLUS (QUOTIENT I 130.) 64.)) (TYO (LOGAND I 127.))))
EXPR)

(DEFPROP MAKNUM
 (LAMBDA (I) (READLIST (LIST (ASCII (PLUS (QUOTIENT I 130.) 64.)) (ASCII (LOGAND I 127.)))))
EXPR)

(DEFPROP LOGAND
 (LAMBDA (A B) (BOOLE 1. A B))
EXPR)

(DEFPROP LABELL
 (LAMBDA (MS) (PRINC MS))
EXPR)

(DEFPROP LABELL
 (NIL (3. . C) (2. . C) (6. . CO) (4. . C) (5. . C) (1. . C))
VALUE)

(DEFPROP LABELL
 (NIL)
SPECIAL)

(DEFPROP INITDRAW
 (LAMBDA NIL
  (PROGN (OUTC
	  (OR# XGPOUT
	       (SETQ XGPOUT
		     (EVAL
		      (CONS (QUOTE OUTPUT)
			    (PROG2 (PROG2 (TERPRI) (PRINC (QUOTE "XGP OUTPUT FILE?")))
				   (LIST (QUOTE XGPOUT) (QUOTE DSK:) (READ))))))))
	 (LINELENGTH 10000.)
	 (SETQ REALWIDTH (SETQ REALHEIGHT 512.))
	 (OR (LESSP (SETQ REALEFT (PLUS 512. REALEFT)) 1024.)
	     (PROG2 (SETQ REALEFT 1.) (LESSP (SETQ REALBOTTOM (PLUS 512. REALBOTTOM)) 1536.))
	     (PROG2 (SETQ REALBOTTOM 1.) (TERPRI) (PRINC (QUOTE ""))))))
EXPR)

(DEFPROP ENDDRAW
 (LAMBDA NIL (PROG2 (LINELENGTH 72.) (OUTC NIL NIL)))
EXPR)

(DEFPROP CLOSEXGP
 (LAMBDA NIL
  (PROG2 (SETQ REALEFT -511.)
	 (SETQ REALBOTTOM 1.)
	 (AND XGPOUT (PROG2 (SETQ XGPOUT NIL) (OUTC (QUOTE XGPOUT) NIL) (OUTC NIL T)))))
EXPR)

(SETQ XGPOUT NIL)

(SETQ REALBOTTOM 1.)

(SETQ REALEFT -511.)

(SETQ REALHEIGHT (SETQ REALWIDTH 512.))

(SETQ EPSILON 0.5)